This week’s Tidy Tuesday features data from the Urban Institute and the US Census. The datasets featured cover wealth, income, and debt over time and by race. In my visualizations, I wanted to look at how wealth inequality, debt, and other factors have changed over time by race and other related socioeconomic variables.
There are notable, observable trends, such as the income distribution of the highest income quantile has increased since the 1970s while the distribution for the lowest quantile has decreased at a similar pace, average earnings for black men and hispanic women are the lowest, white homeowners vastly outnumber black and hispanic homeowners, the student debt burden is sharply increasing especially so for black students, and most high-income earners in the data are either white or Asian. The data reveal the long legacy of financial disenfranchisement of African-Americans and Latinx folks. While the data show that Asians are amongst top-earners, wealth is by far most concentrated in white populations, and inequality between economic levels is increasing.
library(tidyverse)
tuesdata <- tidytuesdayR::tt_load(2021, week = 7)
##
## Downloading file 1 of 11: `home_owner.csv`
## Downloading file 2 of 11: `income_aggregate.csv`
## Downloading file 3 of 11: `income_distribution.csv`
## Downloading file 4 of 11: `income_limits.csv`
## Downloading file 5 of 11: `income_mean.csv`
## Downloading file 6 of 11: `income_time.csv`
## Downloading file 7 of 11: `lifetime_earn.csv`
## Downloading file 8 of 11: `lifetime_wealth.csv`
## Downloading file 9 of 11: `race_wealth.csv`
## Downloading file 10 of 11: `retirement.csv`
## Downloading file 11 of 11: `student_debt.csv`
library(ggplot2)
library(gganimate)
income_aggregate <- tuesdata$income_aggregate %>%
mutate(income_quintile = fct_relevel(income_quintile,
"Lowest", "Second", "Third", "Fourth",
"Highest", "Top 5%")) %>%
mutate(income_share = income_share / 100) # turn percent into decimal
boxplot <- ggplot(income_aggregate, aes(income_quintile, income_share)) +
geom_boxplot() +
ggtitle("Total Aggregate Income Share vs. Income Quintile") +
xlab("Income Quintile") +
ylab("% Share of Income") +
theme_light()
lowest <- income_aggregate %>%
filter(income_quintile == "Lowest")
scatter_low <- ggplot(lowest, aes(year, income_share)) +
geom_point(aes(color = race, size = number)) +
ggtitle("Change in % Share of Income for Lowest Income Quintile") +
xlab("Year") +
ylab("% Share of Income") +
labs(color = "Race", size = "Number of Households") +
theme_light()
highest <- income_aggregate %>%
filter(income_quintile == "Highest")
scatter_high <- ggplot(highest, aes(year, income_share)) +
geom_point(aes(color = race, size = number)) +
ggtitle("Change in % Share of Income for Highest Income Quintile") +
xlab("Year") +
ylab("% Share of Income") +
labs(color = "Race", size = "Number of Households") +
theme_light()
boxplot
scatter_low
scatter_high
anim1 <- scatter_low + transition_states(year,
transition_length = 2,
state_length = 1)
anim2 <- scatter_high + transition_states(year,
transition_length = 2,
state_length = 1)
anim1
anim2